home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1995 November / EnigmA AMIGA RUN 02 (1995)(G.R. Edizioni)(IT)[!][issue 1995-11][Skylink CD].iso / earcd / ead / ead06.dms / ead06.adf / AmigaBasicProgs / switchbox (.txt) < prev    next >
AmigaBASIC Source Code  |  1978-03-13  |  7KB  |  325 lines
  1. restart:
  2. CLEAR : GOSUB setup
  3.  
  4. main:
  5. FOR round=1 TO 4
  6. PUT (80,7+round*8),ball
  7. PUT (515,7+round*8),ball
  8. GOSUB values
  9. SAY TRANSLATE$(intro$(round))
  10. keepgoing:
  11. who=1-who
  12. GOSUB taketurn
  13. IF sc(1-who,round)=>points(round,0) THEN nextround
  14. GOTO keepgoing
  15.  
  16. nextround:
  17. FOR j=0 TO 1: FOR k=5 TO 8
  18. sc(j,k)=0 : NEXT : NEXT
  19. FOR j=0 TO 1 : FOR k=1 TO 4
  20. gx=points(k,0): ac=sc(j,k)
  21. sc(j,5)=sc(j,5)+ac
  22. sc(j,6)=sc(j,6)-(ac=>gx)*gx
  23. sc(j,7)=sc(j,7)+sc(j,k)-sc(1-j,k)
  24. NEXT : NEXT
  25. FOR j=0 TO 1 : FOR k=6 TO 7
  26. sc(j,k)=sc(j,k)+sc(j,5)
  27. NEXT : NEXT
  28. FOR j=0 TO 1
  29. FOR k=5 TO 8 : y$=STR$(sc(j,k))
  30. x=LEN(y$):tx=8+j*64-x:ty=4+k
  31. LOCATE ty,tx-1 : PRINT SPACE$(2)
  32. LOCATE ty,tx : PRINT y$
  33. NEXT : NEXT
  34. NEXT round
  35.  
  36. gohome:
  37. LINE (240,70)-(362,100),2,bf
  38. LOCATE 11,32 : PRINT "play again?"
  39. text$=who$(ABS(sc(1,8)>sc(0,8)))
  40. text$=text$+" wins the game.."
  41. text$=text$+"How about another?"
  42. SAY TRANSLATE$(text$),voice%
  43. FOR j=0 TO 10 : x$=INKEY$ : NEXT
  44.  
  45. again:
  46. x$=INKEY$ : IF x$="" THEN again
  47. SAY TRANSLATE$("OK."),voice%
  48. IF x$="y" OR x$="Y" THEN WINDOW CLOSE 2 : GOTO restart
  49. SAY TRANSLATE$(" Bye-Bye."),voice%
  50. WINDOW CLOSE 2
  51. END
  52.  
  53. taketurn:
  54. FOR j=0 TO nb : lb(j,0)=0 : NEXT : nb=1
  55. SAY TRANSLATE$(who$(who)+CHR$(46))
  56. PUT (140,5),larrow: PUT (440,5),rarrow
  57. FOR j=0 TO 9 : x$=INKEY$ : NEXT
  58.  
  59. getkey:
  60. a$=INKEY$ : IF a$="-" THEN RETURN
  61. IF a$="+" THEN a$=STR$(INT(RND(1)*8+1))
  62. a=VAL(a$) : IF (a<1) OR (a>8) THEN getkey
  63. lb(0,0)=1
  64. FOR j=1 TO 3 : lb(0,j)=0: NEXT
  65. lb(0,4)=a+3
  66.  
  67. moreballs:
  68. ex=1 : FOR j=0 TO nb
  69. IF lb(j,0) THEN ex=0 : GOSUB moveone
  70. NEXT : IF ex=0 THEN moreballs
  71. x=0 : FOR j=13 TO 7 STEP -3 : FOR k=x TO 15-x
  72. PUT (column(k),row(j)+1),blank,AND
  73. NEXT : x=x+1: NEXT : RETURN
  74.  
  75. moveone:
  76. dy=lb(j,0) : dx=lb(j,1) : ly=lb(j,2)
  77. ny=lb(j,3) : nx=lb(j,4)
  78. IF ny THEN
  79.           PUT (column(nx),row(ny+(ly*3))+1),blank,AND
  80. END IF
  81. lb(j,3)=(ny+1)MOD 3
  82. ON ny+1 GOTO pos0,pos1,pos2
  83.  
  84. pos0:
  85.    IF ly>4 THEN lb(j,0)=0 : GOTO score
  86.    vx=0 : GOSUB whichway
  87.    IF (sw(wx,wy,1)) AND (sw(wx,wy,0)=sd) THEN
  88.          vx=1-2*sd : lb(j,3)=ny+1 : lb(j,4)=nx+vx
  89.          GOTO putball
  90.    END IF      
  91.    IF sw(wx,wy,0)=sd THEN
  92.          lb(j,0)=0 
  93.          sw(wx,wy,1)=1 : ny=ny+1
  94.          GOTO putball
  95.    END IF            
  96.    lb(j,3)=ny+1 : GOTO putball
  97.    
  98. pos1:
  99.    lb(j,1)=0 : lb(j,4)=nx+dx : GOTO putball
  100.    
  101. pos2:
  102.     lb(j,2)=ly+1 : GOSUB whichway
  103.     sw(wx,wy,0)=1-sw(wx,wy,0)
  104.     IF sw(wx,wy,1) THEN
  105.         PUT(column(lb(j,4)+1-sd*2),row(ny+(ly*3))),blank,AND
  106.         lb(nb,0)=1 : lb(nb,1)=0 : lb(nb,2)=ly
  107.         lb(nb,3)=0 : lb(nb,4)=nx+1-sd*2 : nb=nb+1
  108.         sw(wx,wy,1)=0
  109.      END IF
  110.      sx=xpos(wx,wy) : sy=ypos(wx,wy)
  111.      wp=sw(wx,wy,0)
  112.      
  113. switch:
  114.     PUT(sx,sy),swblank,AND
  115.     ON wp+1 GOTO left,right
  116. left:
  117.     PUT(sx,sy),lswitch,OR : GOTO bop
  118. right:
  119.     PUT(sx,sy),rswitch,OR
  120. bop:
  121.     SOUND 100,1,64,who
  122.     SOUND 250,1,64,3-who
  123.     RETURN
  124.                
  125. putball:
  126.     SOUND INT(RND(1)*10)*(30*ly)+200,1,64,who
  127.     PUT (column(nx),row(ny+(ly*3)+1)),ball,OR
  128.     RETURN
  129.     
  130. whichway:
  131.     wx=ly : wy=INT((nx+ly-4)/2) : sd=(nx+ly) AND 1 : RETURN
  132.     
  133. score:
  134.    sf=points(round,nx+1): sg=sc(who,round)+sf
  135.    tx=8+63*who+(sg>9)+(sg>99)+(sg>999)
  136.    ty=2+round: a$=MID$(STR$(sg),2)
  137.    LOCATE ty,tx : PRINT a$
  138.    sc(who,round)=sg
  139.    FOR j=1600 TO 200 STEP -300
  140.    SOUND j,1,64,who
  141.    SOUND j+400,1,64,3-who
  142.    NEXT : RETURN
  143.    
  144. values:
  145.    FOR j=0 TO 1
  146.    k=2+70*j : LOCATE 15,k
  147.    PRINT SPACE$(3) : LOCATE 15,k
  148.    PRINT RIGHT$(STR$(points(round,0)),3)
  149.    NEXT
  150.    FOR j=1 TO 16 : k=points(round,j)
  151.    m=6+j*3.75
  152.    IF k>9 THEN
  153.         x=INT(k/10)
  154.         x$=MID$(STR$(x),2,1)
  155.         ELSE
  156.         x$=CHR$(32)
  157.    END IF
  158.    LOCATE 22,m : PRINT x$;
  159.    LOCATE 23,m : PRINT RIGHT$(STR$(k),1);
  160.    NEXT : RETURN
  161.          
  162.  
  163.  
  164. setup:
  165. RANDOMIZE TIMER
  166. DIM voice%(8)
  167. FOR j=0 TO 8
  168. READ voice%(j) : NEXT j
  169. DATA 110,0,150,0,22200,64,10,1,0
  170. greet$="Hi. Welcome to Switchbox."
  171. PRINT greet$
  172. SAY TRANSLATE$(greet$),voice%
  173. SCREEN 2,640,200,2,2
  174. PALETTE 0,0,0,0
  175. PALETTE 1,1,1,1
  176. PALETTE 2,0,0.1,0.7
  177. PALETTE 3,1,1,0.13
  178. WINDOW 2,"Switchbox",,0
  179. DIM larrow(30),rarrow(30),wav%(256),lefthunk(400)
  180. DIM righthunk(400),swblank(100),rswitch(200)
  181. DIM lswitch(200),column(16),row(25)
  182. DIM blank(70),ball(60),piece(80)
  183. DIM sw(8,8,1),lb(32,4),points(4,16),sc(1,8)
  184. FOR j=0 TO 10 : LINE (0,5)-(10,j),3
  185. NEXT
  186. LINE (10,3)-(20,7),3,bf
  187. GET (0,0)-(20,10),larrow
  188. PUT (0,0),larrow
  189. FOR j=0 TO 10
  190. LINE (20,5)-(10,j),3
  191. NEXT
  192. LINE (0,3)-(10,7),3,bf
  193. GET (0,0)-(20,10),rarrow
  194. PUT (0,0),rarrow
  195. GET (8,2)-(22,9),blank
  196. CIRCLE (15,4),7,1
  197. PAINT (16,4),1
  198. GET (8,0)-(22,9),ball
  199. PUT (8,0),ball
  200. FOR j=0 TO 127 : wav%(j)=-127
  201. wav%(j+128)=127: NEXT
  202. FOR j=0 TO 3: WAVE j,wav%
  203. NEXT
  204. DATA 10,"round 1. equal scores."
  205. DATA 2,2,2,2,2,2,2,2
  206. DATA 40,"round 2. fibonachie seequence."
  207. DATA 1,2,3,5,8,13,21,34
  208. DATA 20,"round 3. arithmetic seequence."
  209. DATA 2,3,4,5,6,7,8,9
  210. DATA 80,"round 4. seequence of squares."
  211. DATA 1,4,9,16,25,36,49,64
  212. FOR j=1 TO 4 : READ points(j,0)
  213. READ intro$(j)
  214. FOR k=1 TO 8: READ x
  215. points(j,k+8)=x : points(j,9-k)=x
  216. NEXT k: NEXT j
  217. a=215 : b=2
  218. FOR j=0 TO 4
  219. a=a-30 : b=b+30
  220. FOR k=0 TO j+3
  221. xpos(j,k)=a+k*60
  222. ypos(j,k)=b
  223. NEXT: NEXT
  224. k=0
  225. FOR j=70 TO 520 STEP 30
  226. column(k)=j
  227. k=k+1: NEXT
  228. k=0
  229. FOR j=4 TO 154 STEP 10
  230. row(k)=j: k=k+1 : NEXT
  231.  
  232. start:
  233. SAY TRANSLATE$("First player's name?"),voice%
  234. INPUT "Name of player 1";p0$
  235. SAY TRANSLATE$("Second player's name?"),voice%
  236. INPUT "Name of player 2";p1$
  237. who$(0)=LEFT$(p0$,6): who$(1)=LEFT$(p1$,6)
  238. text$=who$(0)+" plays "+who$(1)+". Is this correct"
  239. PRINT text$
  240. SAY TRANSLATE$(text$),voice%
  241. INPUT query$ : an$=LEFT$(query$,1)
  242. IF LEN(an$)=0 OR an$="y" OR an$="Y" THEN draw
  243. GOTO start
  244.  
  245. draw:
  246. SAY TRANSLATE$("OK."),voice%
  247. CLS
  248. LOCATE 1,6 : PRINT who$(0)
  249. LOCATE 1,66 : PRINT who$(1)
  250. x=4 : FOR j=0 TO 1
  251. LINE (x,12)-(x+110,60),2,bf
  252. LINE (x+6,10)-(x+120,58),3,bf
  253. LINE (x+16,14)-(x+110,48),0,bf
  254. x=x+480 : NEXT
  255. x=1 : FOR j=24 TO 50 STEP 3.7
  256. LOCATE 2,j : PRINT x
  257. x=x+1 : NEXT
  258. LINE (180,0)-(182,40),,bf
  259. GET (180,0)-(182,40),piece
  260. LINE (180,0)-(420,0)
  261. FOR j=210 TO 420 STEP 60
  262. LINE (j,0)-(j+2,12),,bf
  263. PUT (j,40),piece
  264. PUT (j,100),piece
  265. NEXT
  266. FOR j= 180 TO 420 STEP 60
  267. PUT (j,0),piece,OR
  268. PUT (j,70),piece
  269. PUT (j,126),piece
  270. NEXT
  271. PUT (120,126),piece
  272. PUT (150,100),piece
  273. PUT (450,100),piece
  274. PUT (480,126),piece
  275. ERASE piece ' reclaim memory
  276. FOR j=30 TO 570 STEP 30
  277. LINE (j,155)-(j+2,170),1,bf
  278. NEXT
  279. LINE (176,4)-(186,32),2,bf
  280. LINE (416,4)-(426,32),2,bf
  281. LINE (176,32)-(156,42),2
  282. LINE STEP(0,0)-STEP(-10,0),2
  283. LINE STEP(0,0)-STEP(35,-32),2
  284. PAINT (175,31),2
  285. LINE (426,32)-(446,42),2
  286. LINE STEP(0,0)-STEP(10,0),2
  287. LINE STEP(0,0)-STEP(-36,-32),2
  288. PAINT (427,32),2
  289. GET (132,12)-(186,69),lefthunk
  290. GET (416,12)-(456,62),righthunk
  291. l=106 : r=446 : k=42
  292. FOR j=1 TO 4
  293. PUT (l,k),lefthunk,OR
  294. PUT (r,k),righthunk,OR
  295. l=l-30 : r=r+30 : k=k+30
  296. NEXT
  297. ERASE lefthunk,righthunk
  298. LINE (26,153)-(36,165),2,bf
  299. LINE (564,153)-(576,165),2,bf
  300. GET (245,32)-(299,40),swblank
  301. FOR j=0 TO 18
  302. LINE (270+j,40)-(280+j,32),3
  303. NEXT
  304. LINE (245,39)-(280,40),3,bf
  305. GET (245,32)-(298,40),rswitch
  306. PUT (184,32),swblank,AND
  307. FOR j=0 TO 20
  308. LINE (184+j,32)-(193+j,40),3
  309. NEXT
  310. LINE (193,39)-(236,40),3,bf
  311. GET (184,32)-(236,40),lswitch
  312. FOR m=0 TO 4 : FOR n=0 TO m+3
  313. sx=xpos(m,n) : sy=ypos(m,n)
  314. wp=INT(RND(1)*2)
  315. sw(m,n,0)=wp
  316. sw(m,n,1)=0
  317. who=1-who : GOSUB switch
  318. NEXT n : NEXT m
  319. PUT (140,5),larrow
  320. RETURN
  321.  
  322.  
  323.  
  324.  
  325.